home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / cocktail / cg.lha / cg / src / Tree2.mi < prev    next >
Text File  |  1992-11-24  |  4KB  |  210 lines
  1. IMPLEMENTATION MODULE Tree2;
  2.  
  3.  
  4.  
  5.  
  6.  
  7.  
  8.  
  9.  
  10.  
  11.  
  12.  
  13.  
  14.  
  15.  
  16.  
  17.  
  18.  
  19.  
  20.  
  21.  
  22.  
  23.  
  24.  
  25.  
  26.  
  27.  
  28.  
  29.  
  30.  
  31.  
  32.  
  33.  
  34.  
  35.  
  36.  
  37.  
  38.  
  39.  
  40.  
  41.  
  42.  
  43.  
  44.  
  45.  
  46.  
  47. IMPORT SYSTEM, System, General, Memory, DynArray, IO, Layout, StringMem, Strings, Idents, Texts, Sets, Positions;
  48. FROM Tree IMPORT tTree, NoTree, tProcTree, MakeTree, IsType, yyExit,
  49. Classes, 
  50. NoClass, 
  51. Class, 
  52. Attributes, 
  53. NoAttribute, 
  54. AttrOrAction, 
  55. Child, 
  56. Attribute, 
  57. ActionPart, 
  58. yyAlloc, yyPoolFreePtr, yyPoolMaxPtr, yyNodeSize;
  59.  
  60. (* line 143 "" *)
  61. (* line 417 "" *)
  62. (* line 822 "" *)
  63.  
  64.  
  65. TYPE yyPtrtTree    = POINTER TO tTree;
  66.  
  67. VAR yyf    : IO.tFile;
  68. VAR yyLabel    : SHORTCARD;
  69. VAR yyKind    : SHORTCARD;
  70. VAR yyc    : CHAR;
  71. VAR yys    : Strings.tString;
  72.  
  73. PROCEDURE yyMark (yyt: tTree);
  74.  BEGIN
  75.   LOOP
  76.    IF yyt = NoTree THEN RETURN; END;
  77.    INC (yyt^.yyHead.yyMark);
  78.    IF yyt^.yyHead.yyMark > 1 THEN RETURN; END;
  79.  
  80.    CASE yyt^.Kind OF
  81. | Class:
  82. yyMark (yyt^.Class.Attributes);
  83. yyMark (yyt^.Class.Extensions);
  84. yyMark (yyt^.Class.BaseClass);
  85. yyt := yyt^.Class.Next;
  86. | AttrOrAction:
  87. yyt := yyt^.AttrOrAction.Next;
  88. | Child:
  89. yyt := yyt^.Child.Next;
  90. | Attribute:
  91. yyt := yyt^.Attribute.Next;
  92. | ActionPart:
  93. yyt := yyt^.ActionPart.Next;
  94.    ELSE RETURN;
  95.    END;
  96.   END;
  97.  END yyMark;
  98.  
  99. CONST yyInitTreeStoreSize    = 32;
  100.  
  101. VAR yyTreeStoreSize    : LONGINT;
  102. VAR yyTreeStorePtr    : POINTER TO ARRAY [0..50000] OF tTree;
  103. VAR yyLabelCount    : INTEGER;
  104. VAR yyRecursionLevel    : SHORTINT;
  105.  
  106. PROCEDURE yyMapToLabel (yyTree: tTree): SHORTCARD;
  107.  VAR yyi    : INTEGER;
  108.  BEGIN
  109.   FOR yyi := 1 TO yyLabelCount DO
  110.    IF yyTreeStorePtr^[yyi] = yyTree THEN RETURN yyi; END;
  111.   END;
  112.   INC (yyLabelCount);
  113.   IF yyLabelCount = yyTreeStoreSize THEN
  114.    DynArray.ExtendArray (yyTreeStorePtr, yyTreeStoreSize, SYSTEM.TSIZE (tTree));
  115.   END;
  116.   yyTreeStorePtr^[yyLabelCount] := yyTree;
  117.   RETURN yyLabelCount;
  118.  END yyMapToLabel;
  119.  
  120. PROCEDURE yyMapToTree (yyLabel: SHORTCARD): tTree;
  121.  BEGIN RETURN yyTreeStorePtr^[yyLabel]; END yyMapToTree;
  122.  
  123. CONST yyNil    = 374C;
  124. CONST yyNoLabel    = 375C;
  125. CONST yyLabelDef    = 376C;
  126. CONST yyLabelUse    = 377C;
  127.  
  128. PROCEDURE PutTree2 (yyyf: IO.tFile; yyt: tTree);
  129.  BEGIN
  130.   yyf := yyyf;
  131.   IF yyRecursionLevel = 0 THEN yyLabelCount := 0; END;
  132.   INC (yyRecursionLevel);
  133.   yyMark (yyt);
  134.   yyPutTree2 (yyt);
  135.   DEC (yyRecursionLevel);
  136.  END PutTree2;
  137.  
  138. PROCEDURE yyPutTree2 (yyt: tTree);
  139.  BEGIN
  140.   LOOP
  141.    IF yyt = NoTree THEN
  142.     IO.WriteC (yyf, yyNil); RETURN;
  143.    ELSIF yyt^.yyHead.yyMark = 0 THEN
  144.     IO.WriteC (yyf, yyLabelUse); yyLabel := yyMapToLabel (yyt); yyPut (yyLabel);
  145.     RETURN;
  146.    ELSIF yyt^.yyHead.yyMark > 1 THEN
  147.     IO.WriteC (yyf, yyLabelDef); yyLabel := yyMapToLabel (yyt); yyPut (yyLabel);
  148.     IO.WriteC (yyf, CHR (yyt^.Kind));
  149.    ELSE
  150.     IO.WriteC (yyf, CHR (yyt^.Kind));
  151.    END;
  152.    yyt^.yyHead.yyMark := 0;
  153.  
  154.    CASE yyt^.Kind OF
  155. | Class:
  156. yyPutIdent (yyt^.Class.Name);
  157. yyPut (yyt^.Class.Properties);
  158. yyPutTree2 (yyt^.Class.Attributes);
  159. yyPutTree2 (yyt^.Class.Extensions);
  160. yyPutTree2 (yyt^.Class.BaseClass);
  161. yyt := yyt^.Class.Next;
  162. | AttrOrAction:
  163. yyt := yyt^.AttrOrAction.Next;
  164. | Child:
  165. yyPutIdent (yyt^.Child.Name);
  166. yyPutIdent (yyt^.Child.Type);
  167. yyPut (yyt^.Child.Properties);
  168. yyt := yyt^.Child.Next;
  169. | Attribute:
  170. yyPutIdent (yyt^.Attribute.Name);
  171. yyPutIdent (yyt^.Attribute.Type);
  172. yyPut (yyt^.Attribute.Properties);
  173. yyt := yyt^.Attribute.Next;
  174. | ActionPart:
  175. yyt := yyt^.ActionPart.Next;
  176.    ELSE RETURN;
  177.    END;
  178.   END;
  179.  END yyPutTree2;
  180.  
  181. PROCEDURE yyPut (VAR yyx: ARRAY OF SYSTEM.BYTE);
  182.  VAR yyi    : INTEGER;
  183.  BEGIN
  184.   yyi := IO.Write (yyf, SYSTEM.ADR (yyx), INTEGER (HIGH (yyx)) + 1);
  185.  END yyPut;
  186.  
  187. PROCEDURE yyPutIdent (yyi: Idents.tIdent);
  188.  VAR yys    : Strings.tString;
  189.  BEGIN
  190.   Idents.GetString (yyi, yys);
  191.   Strings.WriteL (yyf, yys);
  192.  END yyPutIdent;
  193.  
  194. PROCEDURE BeginTree2;
  195.  BEGIN
  196. (* line 297 "" *)
  197. (* line 749 "" *)
  198.  END BeginTree2;
  199.  
  200. PROCEDURE CloseTree2;
  201.  BEGIN
  202.  END CloseTree2;
  203.  
  204. BEGIN
  205.  yyRecursionLevel := 0;
  206.  yyTreeStoreSize := yyInitTreeStoreSize;
  207.  DynArray.MakeArray (yyTreeStorePtr, yyTreeStoreSize, SYSTEM.TSIZE (tTree));
  208.  BeginTree2;
  209. END Tree2.
  210.